
import Debug.QuickCheck
import Data.List
import Data.Maybe

--------------------------------------------------------------------------
-- 1. 

size :: Expr -> Int
size (Lit _)   = 0
size (Add a b) = 1 + size a + size b
size (Sub a b) = 1 + size a + size b

---

data Expr
  = Lit Int
  | Add Expr Expr
  | Sub Expr Expr
  | Mul Expr Expr
  | Div Expr Expr
 deriving ( Eq, Show )

eval :: Expr -> Int
eval (Lit n)   = n
eval (Add a b) = eval a + eval b
eval (Sub a b) = eval a - eval b
eval (Mul a b) = eval a * eval b
eval (Div a b) = eval a `div` eval b

---

evalMaybe :: Expr -> Maybe Int
evalMaybe (Lit n)   = Just n

evalMaybe (Add a b) = evalMaybe a `add` evalMaybe b
 where
  Nothing `add` _       = Nothing
  _       `add` Nothing = Nothing
  Just x  `add` Just y  = Just (x+y)

evalMaybe (Sub a b) = evalMaybe a `sub` evalMaybe b
 where
  Nothing `sub` _       = Nothing
  _       `sub` Nothing = Nothing
  Just x  `sub` Just y  = Just (x-y)
  
evalMaybe (Mul a b) = evalMaybe a `mul` evalMaybe b
 where
  Nothing `mul` _       = Nothing
  _       `mul` Nothing = Nothing
  Just x  `mul` Just y  = Just (x*y)
  
evalMaybe (Div a b) = evalMaybe a `dvv` evalMaybe b
 where
  Nothing `dvv` _        = Nothing
  _       `dvv` Nothing  = Nothing
  _       `dvv` (Just 0) = Nothing
  Just x  `dvv` Just y   = Just (x `div` y)
  
---

data Expr'
  = Lit' Int
  | Op Ops Expr' Expr'
 deriving ( Eq, Show )
  
data Ops = Add' | Sub' | Mul' | Div' | Mod'
 deriving ( Eq, Show )

eval' :: Expr' -> Maybe Int
eval' (Lit' n)    = Just n
eval' (Op op a b) = ops op (eval' a) (eval' b)
 where
  ops _   Nothing  _                   = Nothing
  ops _   _        Nothing             = Nothing
  ops op  _        (Just 0) | isDiv op = Nothing
  ops op  (Just x) (Just y)            = Just (evalOp op x y)
  
  isDiv op = op `elem` [Div',Mod']
  
  evalOp Add' x y = x + y
  evalOp Sub' x y = x - y
  evalOp Mul' x y = x * y
  evalOp Div' x y = x `div` y
  evalOp Mod' x y = x `mod` y

---

data Exp
  = Lt Int
  | Exp :+: Exp
  | Exp :-: Exp
 deriving ( Eq, Show )

siz :: Exp -> Int
siz (Lt _)    = 0
siz (a :+: b) = 1 + siz a + siz b
siz (a :-: b) = 1 + siz a + siz b

--------------------------------------------------------------------------
-- 2. 

data NTree
  = NilT
  | Node Int NTree NTree
 deriving ( Eq, Show )

---

left, right :: NTree -> NTree
left  (Node _ l _) = l
right (Node _ _ r) = r

---

sumTree :: NTree -> Int
sumTree NilT         = 0
sumTree (Node x l r) = x + sumTree l + sumTree r

---

sizeTree :: NTree -> Int
sizeTree NilT         = 0
sizeTree (Node x l r) = 1 + sizeTree l + sizeTree r

---

collapse :: NTree -> [Int]
collapse NilT         = []
collapse (Node x l r) = collapse l ++ [x] ++ collapse r

---

maxT, minT :: NTree -> Int
maxT t = maximum (collapse t)
minT t = minimum (collapse t)

---

reflect :: NTree -> NTree
reflect NilT         = NilT
reflect (Node x l r) = Node x (reflect r) (reflect l)

---

sort :: NTree -> [Int]
sort t = Data.List.sort (collapse t)

---

prop_ReflectReflect t =
  reflect (reflect t) == t

prop_CollapseLength t =
  length (collapse t) == sizeTree t

prop_CollapseSum t =
  sum (collapse t) == sumTree t

prop_ReflectCollapse t =
  collapse (reflect t) == reverse (collapse t)

---

instance Arbitrary NTree where
  arbitrary = sized arbNTree

arbNTree :: Int -> Gen NTree
arbNTree s =
  frequency [ (1, do return NilT)
            , (s, do n <- arbitrary
                     l <- arbNTree s'
                     r <- arbNTree s'
                     return (Node n l r))
            ]
 where
  s' = s `div` 2

--------------------------------------------------------------------------
-- 3. 

data File
  = File String
  | Dir String [File]
 deriving ( Eq, Show )

type FileSystem = [File]

-- this function returns all paths
search :: FileSystem -> String -> [String]
search files name =
  [ name
  | File name' <- files
  , name == name'
  ] ++
  [ dir ++ "/" ++ path
  | Dir dir files' <- files
  , path <- search files' name
  ]

-- this function returns maybe a path
searchMaybe :: FileSystem -> String -> Maybe String
searchMaybe files name =
  listToMaybe
  ( [ name
    | File name' <- files
    , name == name'
    ] ++
    [ dir ++ "/" ++ path
    | Dir dir files' <- files
    , Just path <- [searchMaybe files' name]
    ]
  )

-- it can also be defined using the first one...
searchMaybe' :: FileSystem -> String -> Maybe String
searchMaybe' files name = listToMaybe (search files name)

exampleFileSystem :: FileSystem
exampleFileSystem =
  [ File "apa"
  , Dir "bepa" [ File "apa", Dir "bepa" [], Dir "cepa" [ File "bepa" ] ]
  , Dir "cepa" [ Dir "bepa" [], Dir "cepa" [ File "apa" ] ]
  ]

--------------------------------------------------------------------------
-- 4. 

data Prop
  = Var Name
  | Prop :&: Prop
  | Prop :|: Prop
  | Not Prop
 deriving ( Eq, Show )

type Name = String

---

vars :: Prop -> [Name]
vars (Var x)   = [x]
vars (a :&: b) = vars a `union` vars b
vars (a :|: b) = vars a `union` vars b
vars (Not a)   = vars a

truthValue :: [(Name,Bool)] -> Prop -> Bool
truthValue val (Var x)   = fromJust (lookup x val)
truthValue val (a :&: b) = truthValue val a && truthValue val b
truthValue val (a :|: b) = truthValue val a || truthValue val b
truthValue val (Not a)   = not (truthValue val a)

---

-- allVals xs enumerates all possible valuations of the variables xs:
--    1. when xs = [], there is just one valuation
--    2. otherwise, we enumerate all possible valuations for the rest
--       of the variables, plus all possible values of x
allVals :: [Name] -> [[(Name,Bool)]]
allVals []     = [[]]
allVals (x:xs) = [ (x,b):val
                 | val <- allVals xs
                 , b <- [False,True]
                 ]

tautology :: Prop -> Bool
tautology a =
  and [ truthValue val a | val <- allVals (vars a) ]

-- an example
hamlet :: Prop
hamlet = Var "to be" :|: Not (Var "to be")

--------------------------------------------------------------------------
-- 5. 

{-
See file AnswersWeek5ExprVar.hs
-}

--------------------------------------------------------------------------

